Syntax10.Scn.Fnt StampElems Alloc 10 May 95 Syntax10m.Scn.Fnt Syntax10i.Scn.Fnt FoldElems MODULE PopupElems; (** MF 27.1.92 /MH/CM/MAH/HM IMPORT Modules, Oberon, Input, Display, Viewers, Files, Fonts, Printer, Texts, MenuViewers, TextFrames, TextPrinter, Bitmaps; CONST ehm = 4; evm = 3; (*element: horizontal margin, vertical margin*) mhm = 5; mvm = 2; (*menu: horizontal margin, vertical margin*) CR = 0DX; DUnit = TextFrames.Unit; PUnit = TextPrinter.Unit; MR = 0; MM = 1; ML = 2; cancel = {ML, MM, MR}; white = 0; grey1 = 12; grey2 = 13; grey3 = 14; black = 15; Elem* = POINTER TO ElemDesc; ElemDesc* = RECORD(Texts.ElemDesc) name*: ARRAY 32 OF CHAR; menu*: Texts.Text; small*: BOOLEAN; (** TRUE if elem displays itself small *) beg, end: LONGINT; (*displayed text stretch in menu*) n, def: INTEGER; (* number of items, default item*) wid, lsp, dsc: INTEGER (*width, line space, descender of item lines*) END; EditFrame = POINTER TO EditFrameDesc; EditFrameDesc = RECORD (TextFrames.FrameDesc) elem: Elem END; ExecMsg* = RECORD (Texts.ElemMsg) frame*: Display.Frame; pos*: LONGINT; keys*: SET END; elemPressed: BOOLEAN; (*TRUE if popup elem should be drawn in pressed mode*) buf: Texts.Buffer; (* copy buffer *) Wr: Texts.Writer; (* auxiliary *) PROCEDURE Min (x, y: INTEGER): INTEGER; BEGIN IF xy THEN RETURN x ELSE RETURN y END END Max; PROCEDURE CopyText (T: Texts.Text): Texts.Text; VAR t: Texts.Text; buf: Texts.Buffer; (*Save destroys the global buf*) BEGIN NEW(buf); Texts.OpenBuf(buf); Texts.Save(T, 0, T.len, buf); t := TextFrames.Text(""); Texts.Append(t, buf); RETURN t END CopyText; PROCEDURE SetDefaultMenu (E: Elem); BEGIN Texts.WriteString(Wr, "right interclick to edit menu"); Texts.WriteLn(Wr); Texts.WriteLn(Wr); Texts.Append(E.menu, Wr.buf) END SetDefaultMenu; PROCEDURE Set (VAR r: Texts.Reader; t: Texts.Text; pos: LONGINT; line: INTEGER); VAR i: INTEGER; ch: CHAR; BEGIN Texts.OpenReader(r, t, pos); FOR i := 0 TO line-1 DO REPEAT Texts.Read(r, ch) UNTIL ch = CR END Set; PROCEDURE Restore (e: Elem); VAR t: Texts.Text; pos: LONGINT; BEGIN t := Texts.ElemBase(e); pos := Texts.ElemPos(e); t.notify(t, Texts.replace, pos, pos+1) END Restore; (* metrics *) PROCEDURE MeasureElem (E: Elem; fnt: Fonts.Font); VAR i, wid, dx, x, y, w, h: INTEGER; p: LONGINT; BEGIN IF E.small THEN E.H := LONG(TextFrames.menuH-1)*DUnit ELSE E.H := LONG(fnt.maxY-fnt.minY+2*evm)*DUnit END; wid := 2*ehm; i := 0; WHILE E.name[i] # 0X DO Display.GetChar(fnt.raster, E.name[i], dx, x, y, w, h, p); INC(wid, dx); INC(i) END; E.W := LONG(wid)*DUnit END MeasureElem; PROCEDURE MeasureMenu* (E: Elem); (*compute E.n, E.def, E.wid, E.lsp, E.dsc*) VAR r: Texts.Reader; ch, oldCh: CHAR; wid, dx, x, y, w, h: INTEGER; p: LONGINT; BEGIN IF E.menu.len = 0 THEN SetDefaultMenu(E) END; E.wid := 0; E.n := 1; E.lsp := 0; wid := 0; oldCh := 0X; E.def := -1; Texts.OpenReader(r, E.menu, 0); Texts.Read(r, ch); WHILE ~r.eot DO IF ch = CR THEN E.wid := Max(E.wid, wid); wid := 0; INC(E.n) ELSIF r.elem # NIL THEN E.lsp := Max(E.lsp, SHORT(r.elem.H DIV TextFrames.Unit)); INC(wid, SHORT(r.elem.W DIV TextFrames.Unit)) ELSE E.lsp := Max(E.lsp, r.fnt.height); E.dsc := Min(E.dsc, r.fnt.minY); Display.GetChar(r.fnt.raster, ch, dx, x, y, w, h, p); INC(wid, dx) END; oldCh := ch; Texts.Read(r, ch) END; IF oldCh = CR THEN DEC(E.n) END; E.wid := Max(E.wid, wid); INC(E.lsp) END MeasureMenu; (* interactive editing of popup menus *) PROCEDURE HandleEdit (F: Display.Frame; VAR M: Display.FrameMsg); VAR F1: EditFrame; BEGIN TextFrames.Handle(F, M); WITH F: EditFrame DO IF M IS Oberon.CopyMsg THEN NEW(F1); TextFrames.Open(F1, F.text, F.org); F1.handle := F.handle; F1.elem := F.elem; M(Oberon.CopyMsg).F := F1 END END HandleEdit; PROCEDURE OpenEditor (E: Elem); VAR V: Viewers.Viewer; F: EditFrame; x, y, i: INTEGER; name: ARRAY 34 OF CHAR; BEGIN name[0] := 22X; i := 0; (* 22X = " *) WHILE E.name[i] # 0X DO name[i+1] := E.name[i]; INC(i) END; name[i+1] := 22X; name[i+2] := 0X; Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y); NEW(F); F.elem := E; TextFrames.Open(F, CopyText(E.menu), 0); F.handle := HandleEdit; V := MenuViewers.New(TextFrames.NewMenu(name, "System.Close System.Copy System.Grow PopupElems.Toggle PopupElems.Update "), F, TextFrames.menuH, x, y) END OpenEditor; (* file input/output *) PROCEDURE Load (VAR R: Files.Rider; E: Elem); CONST VersionTag = 01X; menuElem = 0; VAR ch: CHAR; val: LONGINT; options: SET; BEGIN Files.Read (R, ch); IF ch = VersionTag THEN Files.ReadString (R, E.name); Files.ReadNum (R, val); Files.ReadSet (R, options); IF menuElem IN options THEN E.small:=TRUE ELSE E.small:=FALSE END; ELSE Files.Set (R, Files.Base (R), Files.Pos (R)-1); Files.ReadString(R, E.name); Files.ReadBool(R, E.small) END; E.menu := TextFrames.Text(""); Texts.Load(R, E.menu) END Load PROCEDURE Store (VAR R: Files.Rider; E: Elem); VAR ch: CHAR; BEGIN Files.WriteString(R, E.name); Files.WriteBool(R,E.small); Texts.Store(R, E.menu) END Store; (* graphics *) PROCEDURE PrintElem (E: Elem; X, Y: INTEGER; fnt: Fonts.Font); VAR W, H: INTEGER; BEGIN W:=SHORT((E.W-1) DIV PUnit); H:=SHORT(E.H DIV PUnit); IF E.small THEN Printer.String(X, Y, E.name, fnt.name); Printer.ReplPattern(X, Y-2, W, 1, 2) ELSE INC (W, 2 * ehm * DUnit DIV PUnit); Printer.ReplConst(X, Y, W, 2); Printer.ReplConst(X, Y+H-2, W, 2); Printer.ReplConst(X, Y+2, 2, H-4); Printer.ReplConst(X+W-2, Y+2, 2, H-4); Printer.String(X + ehm * DUnit DIV PUnit, Y + SHORT(LONG(evm-fnt.minY)*DUnit DIV PUnit), E.name, fnt.name) END PrintElem; PROCEDURE DrawBigElem (pressed: BOOLEAN; X, Y, W, H: INTEGER); BEGIN IF pressed THEN Display.ReplConst(grey1, X, Y, W, H, Display.replace); Display.ReplConst(grey3, X, Y+2, W-2, H-2, Display.replace); Display.ReplConst(grey2, X+2, Y+2, W-4, H-4, Display.replace); Display.Dot(grey3, X, Y+1, Display.replace); Display.Dot(grey3, X+W-2, Y+H-1, Display.replace); ELSE Display.ReplConst(grey3, X, Y, W, H, Display.replace); Display.ReplConst(grey1, X, Y+2, W-2, H-2, Display.replace); Display.ReplConst(grey2, X+2, Y+2, W-4, H-4, Display.replace); Display.Dot(grey1, X, Y+1, Display.replace); Display.Dot(grey1, X+W-2, Y+H-1, Display.replace); END DrawBigElem; PROCEDURE DrawSmallElem (pressed: BOOLEAN; X, Y, W, H: INTEGER); BEGIN IF pressed THEN Display.ReplConst(white, X, Y, W, H, Display.replace); Display.ReplConst(grey3, X, Y+1, W-1, H-1, Display.replace); Display.ReplConst(grey2, X+1, Y+1, W-2, H-2, Display.replace) ELSE Display.ReplConst(black, X, Y, W, H, Display.replace); Display.ReplConst(grey3, X, Y+1, W-1, H-1, Display.replace); Display.ReplConst(grey2, X, Y+2, W-2, H-2, Display.replace); Display.ReplConst(white, X, Y+1, 1, H-1, Display.replace); Display.ReplConst(white, X, Y+H-1, W-1, 1, Display.replace) END DrawSmallElem; PROCEDURE DrawElem (E: Elem; col: SHORTINT; X, Y: INTEGER; fnt: Fonts.Font); VAR W, H: INTEGER; i, x, y, w, h, dx: INTEGER; pat: Display.Pattern; BEGIN W := SHORT(E.W DIV DUnit); H := SHORT(E.H DIV DUnit); IF E.small THEN DrawSmallElem(elemPressed, X, Y, W, H); INC(Y, 3) ELSE DrawBigElem(elemPressed, X, Y, W, H); INC(Y, evm-fnt.minY) END; INC(X, ehm); i := 0; WHILE E.name[i] # 0X DO Display.GetChar(fnt.raster, E.name[i], dx, x, y, w, h, pat); Display.CopyPattern(col, pat, X+x, Y+y, Display.paint); INC(X, dx); INC(i) END DrawElem; PROCEDURE DrawLine (VAR r: Texts.Reader; f: Display.Frame; X, Y: INTEGER); VAR e: Texts.Elem; ch: CHAR; dx, x, y, w, h: INTEGER; pat: Display.Pattern; m: TextFrames.DisplayMsg; BEGIN LOOP Texts.Read(r, ch); IF r.eot OR (ch = CR) THEN EXIT ELSIF r.elem # NIL THEN e := r.elem; y := r.fnt.minY; m.prepare := FALSE; m.fnt := r.fnt; m.col := r.col; m.pos := Texts.Pos(r) - 1; m.frame := f; m.X0 := X; m.Y0 := Y+y; m.elemFrame := NIL; e.handle(e, m); INC(X, SHORT(e.W DIV TextFrames.Unit)) ELSE Display.GetChar (r.fnt.raster, ch, dx, x, y, w, h, pat); Display.CopyPattern(r.col, pat, X+x, Y+y, Display.paint); INC(X, dx) END END DrawLine; PROCEDURE DrawMenu(E: Elem; F: Display.Frame; X, Y, W, H: INTEGER); VAR R: Texts.Reader; X0, bot: INTEGER; BEGIN IF E.n > 1 THEN Display.ReplConst(black, X, Y, W, H, Display.replace); Display.ReplConst(grey2, X+1, Y+1, W-2, H-2, Display.replace); E.beg := 0; bot := Y + mvm - E.dsc; X0 := X + mhm; X := X0; Y := Y + H - mvm - E.lsp - E.dsc; Texts.OpenReader(R, E.menu, 0); WHILE ~R.eot & (Y >= bot) DO DrawLine(R, F, X, Y); Y := Y - E.lsp; X := X0 END; E.end := Texts.Pos(R); END DrawMenu; (* actions *) PROCEDURE ExecCmd (E: Elem; F: Display.Frame; pos: LONGINT; keys: SET); VAR s: Texts.Scanner; par: Oberon.ParList; res, i, j: INTEGER; ch: CHAR; m: TextFrames.TrackMsg; BEGIN Texts.OpenScanner(s, E.menu, pos); Texts.Scan(s); IF (s.class = Texts.Name) & (s.line = 0) THEN i := 0; WHILE (i < s.len) & (s.s[i] # ".") DO INC(i) END; j := i + 1; WHILE (j < s.len) & (s.s[j] # ".") DO INC(j) END; IF (j >= s.len) & (s.s[i] = ".") THEN NEW(par); par.frame := F; par.vwr := Viewers.This(F.X, F.Y); par.text := E.menu; par.pos := Texts.Pos(s)-1; Oberon.Call(s.s, par, ML IN keys, res); (* left interclick -> unload module *) IF res > 0 THEN Texts.WriteString(Wr, "Call error: "); Texts.WriteString(Wr, Modules.importing); IF (res = 1) OR (res = 5) THEN Texts.WriteString(Wr, " not found") ELSIF res = 2 THEN Texts.WriteString(Wr, " not an obj-file") ELSIF res = 3 THEN Texts.WriteString(Wr, " imports "); Texts.WriteString(Wr, Modules.imported); Texts.WriteString(Wr, " with bad key") ELSIF res = 4 THEN Texts.WriteString(Wr, " not enough memory") ELSIF res = 5 THEN Texts.WriteString(Wr, " module not found") ELSIF res = 6 THEN Texts.WriteString(Wr, " command not found") ELSE Texts.WriteString(Wr, " res = "); Texts.WriteInt(Wr, res, 0) END ELSIF res < 0 THEN INC(i); WHILE i < s.len DO Texts.Write(Wr, s.s[i]); INC(i) END; Texts.WriteString(Wr, " not found") END; IF res # 0 THEN Texts.WriteLn(Wr); Texts.Append(Oberon.Log, Wr.buf) END END ELSIF (s.class = Texts.Char) & (s.c = Texts.ElemChar) & (s.line = 0) THEN Texts.OpenReader(s, E.menu, pos); Texts.Read(s, ch); m.frame := NIL; m.keys := {MM}; s.elem.handle(s.elem, m) END ExecCmd; PROCEDURE SelectMenu (E: Elem; F: Display.Frame; X, Y, W, H, ex, ey, ew, eh: INTEGER; VAR cmd: INTEGER; VAR keysum: SET); VAR mx, my, top, bot, left, right, newCmd: INTEGER; keys: SET; B: Bitmaps.Bitmap; PROCEDURE TrackMouse (VAR x, y: INTEGER; VAR keys, keysum: SET); BEGIN Input.Mouse(keys, x, y); keysum := keysum+keys; Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y) END TrackMouse; PROCEDURE Flip (in: BOOLEAN; cmd: INTEGER); VAR R: Texts.Reader; x, y, w, h, X0, Y0: INTEGER; BEGIN IF (E.n>1) & (cmd >= 0) THEN X0 := X+mhm; Y0 := Y+H-(E.lsp*(cmd+1))-E.dsc-mvm; x := left; y := Y0 + E.dsc - 1; w := right - left + 1; h := E.lsp + 2; IF in THEN Display.ReplConst(black, x, y, w, 1, Display.replace); Display.ReplConst(black, x+w-1, y, 1, h-1, Display.replace); Display.ReplConst(white, x, y+1, 1, h-1, Display.replace); Display.ReplConst(white, x, y+h-1, w, 1, Display.replace); Display.ReplConst(grey1, x+1, y+1, w-2, h-2, Display.replace) ELSE Display.ReplConst(grey2, x, y, w, h, Display.replace) END; Set(R, E.menu, E.beg, cmd); DrawLine(R, F, X0, Y0) END END Flip; PROCEDURE BwdLine (VAR pos: LONGINT); VAR r: Texts.Reader; ch: CHAR; BEGIN DEC(pos); REPEAT DEC(pos); Texts.OpenReader(r, E.menu, pos); Texts.Read(r, ch) UNTIL (pos = 0) OR (ch = CR); IF ch = CR THEN INC(pos) END END BwdLine; PROCEDURE FwdLine (VAR pos: LONGINT); VAR r: Texts.Reader; ch: CHAR; BEGIN Texts.OpenReader(r, E.menu, pos); REPEAT Texts.Read(r, ch) UNTIL r.eot OR (ch = CR); pos := Texts.Pos(r); END FwdLine; PROCEDURE ScrollUp; VAR cmd: INTEGER; BEGIN cmd := H DIV E.lsp - 1; Flip(FALSE, cmd); Display.CopyBlock(left, bot, W-2, H-2*mvm-E.lsp, left, bot+E.lsp, Display.replace); FwdLine(E.beg); FwdLine(E.end); Flip(FALSE, cmd) END ScrollUp; PROCEDURE ScrollDown; BEGIN Flip(FALSE, 0); Display.CopyBlock(left, bot+E.lsp, W-2, H-2*mvm-E.lsp, left, bot, Display.replace); BwdLine(E.beg); BwdLine(E.end); Flip(FALSE, 0) END ScrollDown; BEGIN left:=X+1; right:=X+W-2; bot:=Y+mvm; top:=Y+H-mvm; Oberon.RemoveMarks(X, Y, W, H); Oberon.FadeCursor(Oberon.Mouse); B := Bitmaps.New(W, H); Bitmaps.CopyBlock(Bitmaps.Disp, B, X, Y, W, H, 0, 0, 0); DrawMenu(E, F, X, Y, W, H); Flip(TRUE, cmd); keysum := {}; newCmd := -1; REPEAT TrackMouse(mx, my, keys, keysum); IF keysum = cancel THEN cmd := -1 ELSIF (mx >= left) & (mx <= right) THEN WHILE (my <= bot) & (E.end < E.menu.len) & (keys # {}) DO ScrollUp; TrackMouse(mx, my, keys, keysum) END; WHILE (my >= top) & (E.beg > 0) & (keys # {}) DO ScrollDown; TrackMouse(mx, my, keys, keysum) END; IF (my > bot) & (my <= top) THEN newCmd:=(top-my) DIV E.lsp; IF newCmd # cmd THEN Flip(FALSE, cmd); Flip(TRUE, newCmd); cmd:=newCmd END ELSIF (mx < ex) OR (mx >= ex+ew) OR (my < ey) OR (my >= ey+eh) OR (newCmd >= 0) THEN Flip(FALSE, cmd); cmd := -1 END ELSIF (mx < ex) OR (mx >= ex+ew) OR (my < ey) OR (my >= ey+eh) OR (newCmd >= 0) THEN Flip(FALSE, cmd); cmd := -1 END UNTIL keys = {}; Oberon.FadeCursor(Oberon.Mouse); Bitmaps.CopyBlock(B, Bitmaps.Disp, 0, 0, W, H, X, Y, 0) END SelectMenu; PROCEDURE Popup (E: Elem; col: SHORTINT; X, Y: INTEGER; fnt: Fonts.Font; F: Display.Frame); VAR W, H, menuX, menuY, menuW, menuH, cmd, i: INTEGER; pos: LONGINT; r: Texts.Reader; keys: SET; draw: TextFrames.DisplayMsg; exec: ExecMsg; BEGIN draw.prepare := FALSE; draw.fnt := fnt; draw.col := col; draw.frame := F; draw.X0 := X; draw.Y0 := Y; W := SHORT(E.W DIV DUnit); H := SHORT(E.H DIV DUnit); menuW := E.wid + 2*mhm; menuH := E.n*E.lsp + 2*mvm; IF Y - menuH >= 0 THEN menuY := Y - menuH ELSIF Y + H + menuH <= Display.Height THEN menuY := Y + H ELSE menuY := 0 END; IF X + menuW <= Display.Width THEN menuX := X ELSE menuX := Max(X + W - menuW, 0) END; i := Display.Height - 2*mvm; IF menuH > i THEN menuH := i DIV E.lsp * E.lsp + 2*mvm END; cmd := Max(E.def, 0); elemPressed := TRUE; E.handle(E, draw); SelectMenu(E, F, menuX, menuY, menuW, menuH, X, Y, W, H, cmd, keys); elemPressed := FALSE; E.handle(E, draw); IF keys = {MM, MR} THEN OpenEditor(E) ELSIF (keys # cancel) & (cmd > -1) THEN E.def := cmd; Set(r, E.menu, E.beg, cmd); exec.frame := F; exec.pos := Texts.Pos(r); exec.keys := keys; E.handle(E, exec) END Popup; (* element *) PROCEDURE Handle* (E: Texts.Elem; VAR msg: Texts.ElemMsg); VAR e: Elem; BEGIN WITH E: Elem DO WITH msg: TextFrames.DisplayMsg DO IF msg.prepare THEN MeasureElem(E, msg.fnt) ELSE DrawElem(E, msg.col, msg.X0, msg.Y0, msg.fnt) END | msg:TextPrinter.PrintMsg DO IF ~msg.prepare THEN PrintElem(E, msg.X0, msg.Y0, msg.fnt) END | msg:Texts.CopyMsg DO IF msg.e = NIL THEN NEW(e); msg.e := e ELSE e := msg.e(Elem) END; Texts.CopyElem(E, e); e.name:=E.name; e.n := E.n; e.wid:=E.wid; e.lsp:=E.lsp; e.dsc:=E.dsc; e.small := E.small; e.def := E.def; e.menu:=TextFrames.Text(""); Texts.Save(E.menu, 0, E.menu.len, buf); Texts.Append(e.menu, buf) | msg:Texts.IdentifyMsg DO msg.mod:="PopupElems"; msg.proc:="Alloc" | msg:Texts.FileMsg DO IF msg.id=Texts.load THEN Load(msg.r, E); MeasureMenu(E) ELSIF msg.id=Texts.store THEN Store(msg.r, E) END | msg:TextFrames.TrackMsg DO IF msg.keys = {MM} THEN Popup(E, msg.col, msg.X0, msg.Y0, msg.fnt, msg.frame); msg.keys := {} END | msg: ExecMsg DO ExecCmd(E, msg.frame, msg.pos, msg.keys) ELSE END END Handle; PROCEDURE Alloc*; VAR E: Elem; BEGIN NEW(E); E.handle:=Handle; Texts.new:=E END Alloc; PROCEDURE Insert0 (small: BOOLEAN); VAR E: Elem; S: Texts.Scanner; insert: TextFrames.InsertElemMsg; BEGIN NEW(E); Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); IF ~(S.class IN {Texts.Name, Texts.String}) THEN S.s := "Popup" END; COPY(S.s, E.name); E.small := small; E.menu := TextFrames.Text(""); SetDefaultMenu(E); MeasureMenu(E); E.handle := Handle; insert.e := E; Viewers.Broadcast(insert) END Insert0; PROCEDURE Insert*; BEGIN Insert0(FALSE) END Insert; PROCEDURE InsertMenu*; BEGIN Insert0(TRUE) END InsertMenu; PROCEDURE Toggle*; VAR text: Texts.Text; E: Elem; pos: LONGINT; BEGIN IF Oberon.Par.frame = Oberon.Par.vwr.dsc THEN E := Oberon.Par.frame.next(EditFrame).elem; E.small := ~E.small; Restore(E) END Toggle; PROCEDURE Update*; VAR F: EditFrame; S: Texts.Scanner; menuText, text: Texts.Text; E: Elem; pos: LONGINT; BEGIN IF Oberon.Par.frame = Oberon.Par.vwr.dsc THEN F := Oberon.Par.frame.next(EditFrame); E := F.elem; menuText := Oberon.Par.frame(TextFrames.Frame).text; Texts.OpenScanner(S, menuText, 0); Texts.Scan(S); IF ~(S.class IN {Texts.Name, Texts.String}) THEN S.s := "Popup" END; COPY(S.s, E.name); E.menu := CopyText(F.text); MeasureMenu(E); Restore(E); Texts.OpenReader(S, menuText, menuText.len-1); Texts.Read(S, S.c); IF S.c = "!" THEN Texts.Delete(menuText, menuText.len-1, menuText.len) END END Update; BEGIN elemPressed := FALSE; NEW(buf); Texts.OpenBuf(buf); Texts.OpenWriter(Wr) END PopupElems.